COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00008 ENDMK
C⊗;
ENTRY;
BEGIN "PPCODE"
DEFINE $$PRGID=TRUE, $PPCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

REQUIRE "[][]" DELIMITERS;
REDEFINE MAKEOP(OPNUM,OPNAM,OPVAL)"[]" = [,"OPNAM"];
PRESET_WITH "not valid" INTOPS;
STRING ARRAY SPCODE[0:#ALINTOPS/2];

SIMPLE STRING PROCEDURE SCODE(INTEGER I);
	IF I MOD 2 = 0 AND 0≤I≤#ALINTOPS THEN RETURN(SPCODE[I/2])
		ELSE RETURN(SPCODE[0]);

RECURSIVE PROCEDURE PPRIN(INTEGER ARRAY RR; INTEGER SNUM,INDEXF; STRING INDENT);
BEGIN
	! program to print out pcode from number form to pcode form;
	INTEGER INDEX;
	PROCEDURE RPRINT;
	BEGIN "print real numbers"
		PRINT("	",RFVAL(RR[INDEX+1],
				RR[INDEX+2]));
		INDEX←INDEX+2;
	END;

	PROCEDURE OPRINT;
	"prints octal"	PRINT("	",CVOS(RR[INDEX←INDEX+1]));

	PROCEDURE RDPRINT(INTEGER OFFSET(-1));
	"prints relative decimal"
		BEGIN INTEGER I;
		! if offset not specified then take wrt to current position ;
		I←RR[INDEX←INDEX+1];
		PRINT("	.");
		IF I≥0 THEN PRINT("+");
		PRINT(I,"(D)");
		IF OFFSET<0 THEN PRINT("	{=",INDEX+RR[INDEX],"(D)}")
			ELSE PRINT("	{=",RR[INDEX]+OFFSET,"(D)}");
		END;

	PROCEDURE DPRINT;
	"prints decimal"
		PRINT("	",RR[INDEX←INDEX+1],"(D)");

	PROCEDURE NLPRINT;
	"prints newline"
		PRINT(CRLF,INDEX+1,":	",INDENT);

	PROCEDURE NPCODE;
	BEGIN	"prints new pcode"
		INTEGER I,J;
		NLPRINT;		! start new line;
		I←RR[INDEX←INDEX+1]/2;
		J←RR[INDEX] MOD 2;
		IF J=0 AND 1≤I≤ARRINFO(SPCODE,2)
			THEN PRINT(SPCODE[I])
			ELSE PRINT(RR[INDEX],"(D)");
		IF J=0 THEN
		CASE I OF
		BEGIN
		    [XJUMP/2][XPRINT/2][XJUMPC/2][XFORCHK/2]
			RDPRINT;
		    [XRJMP/2][XRPRINT/2][XRJMPC/2][XRFRCHK/2]
			RDPRINT;
		    [XPUSHSCI/2]
			RPRINT;
		    [XAFFIX/2]
			BEGIN
			OPRINT;	OPRINT;	OPRINT;
			IF RR[INDEX] LAND '2000 THEN OPRINT;
			END;
		    [XAGTVAL/2][XACHNGE/2][XARTVAL/2]
			BEGIN OPRINT; OPRINT; END;
		    [XRCASE/2]
			BEGIN
			INTEGER NCASES,I,J;
			DPRINT;	NCASES←ABS(RR[J←INDEX])+1;
			FOR I←1 STEP 1 UNTIL NCASES DO
				BEGIN NLPRINT; RDPRINT(J+1); END;
			END;
		    [XGTBLK/2]
			BEGIN
			DPRINT;PPRIN(RR,INDEX+1,INDEX+RR[INDEX],INDENT&"    ");
			INDEX←INDEX+RR[INDEX];
			NLPRINT; PRINT(RR[INDEX←INDEX+1],"(D)");
			END;
		    [XGTVAL/2][XCHNGE/2][XWHERE/2][XPUSHINTI/2][XKVAR/2]
		    [XCOPY/2][XRETURN/2][XPROC/2][XREPLAC/2]
		    [XGATHER/2][XCMDSBL/2][XSTOP/2][XCHCMP/2]
		    [XPUSHOFFSET/2][XPAFFIX/2][XCMENBL/2][XTFRCST/2]
		    [XARRINI/2]
			OPRINT;
		    [XRCENTER/2][XRPMOVE/2][XRTADRIVE/2][XRTDDRIVE/2]
			BEGIN RDPRINT; OPRINT; END;
		    [XMVAR/2]
			DO OPRINT UNTIL RR[INDEX]=0;
		    [XAPUSHOFFSET/2]
			BEGIN OPRINT;OPRINT END;
		    [XGTINT/2][XGVALS/2][XCHNGS/2][XPUNFIX/2]
			INDEX←INDEX;
		    [XPSPROUT/2]
			BEGIN INTEGER I,N;
			    DPRINT;
			    N←RR[INDEX];
			    FOR I←1 STEP 1 UNTIL N DO
				BEGIN NLPRINT; RDPRINT;OPRINT; END;
			    NLPRINT; OPRINT;
			END;
		    ELSE INDEX←INDEX
		END;
		
	END;
	INDEX←SNUM-1;
	WHILE INDEX<INDEXF DO NPCODE;
END;

INTERNAL PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1));
BEGIN	PPRIN(EXPR$:BODY[EE],SNUM,EXPR$:#BODY[EE],NULL);
	PRINT(CRLF,EXPR$:#BODY[EE]+1,":",CRLF);
END;

PROCEDURE PPPCODE;ppcode(null_record);
END;